home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / e_SML / bootstrap / make_opcodes.sml next >
Encoding:
Text File  |  1996-07-24  |  1.6 KB  |  62 lines  |  [TEXT/Moml]
  1. (* make_opcodes.sml -- 08Jun96 e *)
  2.  
  3. (* usually no need: load "BasicIO"; load List; load String; *)
  4.  
  5. load "FileSys";
  6.  
  7. open BasicIO;
  8.  
  9. fun make_opcodes_guts is os =
  10.    let fun delim c = List.exists (fn x => (x = c)) (String.explode " ,;{}\n\t")
  11.        fun enums x =
  12.          let val lin = input_line is
  13.              val toks = String.tokens delim lin
  14.          in
  15.            if toks = []
  16.            then if end_of_stream is then () else enums x (* blank line *)
  17.            else if String.compare (hd toks, "enum") = EQUAL
  18.            then (outputc os "\n"; enums 0) (* new start *)
  19.            else if String.< (hd toks, "A")
  20.            then enums x (* comment *)
  21.            else (
  22.                  outputc os "val ";
  23.                  outputc os (hd toks);
  24.                  outputc os " = ";
  25.                  outputc os (makestring x);
  26.                  outputc os ";\n";
  27.                  enums (x + 1)
  28.                 )
  29.          end
  30.    in enums 0
  31.    end
  32. ;
  33.  
  34. fun make_opcodes hdr src tgt =
  35.    let val is = open_in src
  36.    in let val os = open_out tgt
  37.       in
  38.          (outputc os hdr;
  39.           make_opcodes_guts is os;
  40.           close_in is;
  41.           close_out os)
  42.          handle x => (close_out os; FileSys.remove tgt; raise x)
  43.       end
  44.       handle x => (close_in is; raise x)
  45.    end
  46. ;
  47.  
  48. (*
  49. val home = "jalaMPW:ml:mosml140:";
  50.  
  51. load "Date";
  52. load "Time";
  53.  
  54. make_opcodes ("(* made by make_opcodes.sml -- "
  55.               ^ (Date.toString (Date.fromTime (Time.now ())))
  56.               ^ " *)\n\n")
  57.              (home ^ "src:!runtime:instruct.h")
  58.              (home ^ "src:compiler:Opcodes.sml**new**");
  59. *)
  60.  
  61. (* end *)
  62.